perm filename DOXAP.SAI[XGP,TES] blob
sn#027199 filedate 1973-02-22 generic text, type T, neo UTF8
00100 COMMENT
00200 HERE GOES NOTHING
00300 ADDED RPG ENTRY MAY 20, 1972 RKJ
00400 REVISED MAY 1, 1972 RICH JOHNSSON & PHIL KARLTON
00500 CREATED APRIL 29, 1972 PHIL KARLTON & RICH JOHNSSON;
00600
00700 BEGIN "DOXAP"
00800 REQUIRE "BAYSAI.SAI[A700LE03]" SOURCE!FILE;
00900 REQUIRE "BRKSER.SAI[A700LE03]" SOURCE!FILE;
01000 REQUIRE 4096 STRING!SPACE;
01100
01200 DEFINE FF="'14", RUBOUT="'177";
01300 DEFINE LDXNUM(X)="(X LSH -7) & X"; ! TWO ASCII CHARS;
01400 DEFINE OUTPUTLINE(X)="BEGIN OUT(OUTCHN,X);OUT(OUTCHN,CRLF);
01500 LINE←INPUT(INCHN,MAINBRK); END";
01600
01700 DEFINE CKNJB="(IF NJB THEN NJB ELSE NULL)";
01800
01900
02000 INTEGER INCHN,OUTCHN,MAINBRK,EOF,BRCHR,LFBRK,LFAPPBRK,CC,
02100 AKSET,CMD,FILE,EXT,PPN,TEXTBRK,NJB,INLENGTH;
02200 STRING LINE,INFILE,OUTFILE,PPNSTR;
02300
02400 DEFINE COMPKSET="'1";
02500 DEFINE BCL="('177&'26)",
02600 ECL="('177&'25)";
02700 DEFINE USEA="('177&'14)",
02800 USEB="('177&'15)",
02900 VERT="('177&'1)",
03000 TOPM="('177&'3)",
03100 BOTM="('177&'4)",
03200 NUML="('177&'5)",
03300 JWID="('177&'16)",
03400 JPAD="('177&'17)",
03500 XTAB="('177&'30)",
03600 XRUB="('177&'177)",
03700 XVSB="('177&'20)",
03800 LFTM="('177&'2)",
03900 XBJY="('177&'32)",
04000 XBJN="('177&'33)",
04100 XQTE="('177&'34)";
04200
04300 EXTERNAL INTEGER RPGSW;
04400
04500 STRING PROCEDURE RPGFILE;
04600 BEGIN "RPGFILE"
04700 INTEGER PROCEDURE PJOB;
04800 START!CODE DEFINE CALLI="'47000000000"; CALLI 1, '30; END;
04900 INTEGER CHAN,BRK;
05000 RPGSW←FALSE;
05100 SETFORMAT(-3,0);
05200 OPEN(CHAN←GETCHAN,"DSK",0,1,0,100,ZILCH,ZILCH);
05300 LOOKUP(CHAN,CVS(PJOB)&"DOX.TMP",DUM);
05400 OUTFILE←IF DUM THEN NULL ELSE INPUT(CHAN,LFBRK);
05500 CLOSE(CHAN); RENAME(CHAN,NULL,0,ZILCH); RELEASE(CHAN);
05600 START!CODE
05700 DEFINE CALLI="'047000000000";
05800 CALLI 1,12;
05900 CALLI 0,12;
06000 END;
06100 RETURN(OUTFILE);
06200 END "RPGFILE";
00100 STRING PROCEDURE DOESCAPE(BOOLEAN READIT);
00200 BEGIN "DOESCAPE"
00300 STRING S;
00400 IF NOT READIT THEN RETURN (RUBOUT&LOP(LINE)&LOP(LINE));
00500 INLENGTH←2;
00600 S←RUBOUT&INPUT(INCHN,0);
00700 INLENGTH←200;
00800 RETURN (S);
00900 END "DOESCAPE";
01000
01100 PROCEDURE PROCESSLINE;
01200 BEGIN "PROCL"
01300 STRING OUTBUF;
01400 INTEGER NUM,CMDCHR;
01500
01600 CMDCHR←BRCHR;
01700 OUTBUF ← LINE;
01800 LINE←NULL;
01900 WHILE LENGTH(LINE)=0 OR LINE[INF-1 FOR 1]='34 DO
02000 LINE←LINE&INPUT(INCHN,LFAPPBRK);
02100
02200 IF CMDCHR=COMPKSET OR (CMDCHR=NJB AND NJB≠0) OR (CMDCHR=CC AND (LINE="I" OR LINE="L")) THEN
02300 BEGIN "PRTXT"
02400
02500 DO BEGIN "TXTPRC"
02600 IF CMDCHR=CC THEN
02700 BEGIN
02800 IF (DUM←LOP(LINE))≠"P" THEN NUM←INTSCAN(LINE,ZILCH);
02900 ZILCH←LOP(LINE);
03000 OUTBUF←OUTBUF & (IF DUM="I" THEN XTAB&LDXNUM(NUM)
03100 ELSE IF DUM="L" THEN XVSB&NUM
03200 ELSE XQTE&LOP(LINE));
03300 END
03400 ELSE IF CMDCHR=NJB THEN OUTBUF←OUTBUF&XRUB
03500 ELSE IF CMDCHR=RUBOUT THEN OUTBUF←OUTBUF&DOESCAPE(FALSE)
03600 ELSE IF (DUM←LOP(LINE))=COMPKSET OR (DUM=NJB AND NJB≠0) OR DUM=CC
03700 THEN OUTBUF←OUTBUF & DUM
03800 ELSE BEGIN
03900 OUTBUF ← OUTBUF & (IF AKSET THEN (USEB) ELSE (USEA))&DUM;
04000 START!CODE SETCMM 0,AKSET END;
04100 END;
04200 OUTBUF←OUTBUF&SCAN(LINE,MAINBRK,CMDCHR);
04300 END "TXTPRC" UNTIL LENGTH(LINE)=0;
04400
04500 OUTPUTLINE(OUTBUF);
04600 OUTBUF←NULL;
04700 RETURN;
04800 END "PRTXT";
04900
05000 IF OUTBUF=FF THEN OUT(OUTCHN,FF); ! OTHERWISE COMMAND LINE AFTER FF LOSES FF!!!;
05100 OUTBUF←BCL;
05200 DO ! UNTIL END OF LINE;
05300 BEGIN "DECOD"
05400 CMD ← LOP(LINE);
05500
05600 CASE CMD - "A" OF
05700 BEGIN
05800 BEGIN "A" ! A=VERTICAL SPACTING;
05900 NUM ← INTSCAN(LINE,ZILCH);
06000 ZILCH←LOP(LINE);
06100 OUTBUF ← OUTBUF & VERT & LDXNUM(NUM);
06200 END "A";
06300 BEGIN "B" ! B=TOP MARGIN;
06400 NUM ← INTSCAN(LINE,ZILCH);
06500 ZILCH←LOP(LINE);
06600 OUTBUF ← OUTBUF & TOPM & LDXNUM(NUM);
06700 END "B";
06800 BEGIN "C" ! C=BOTTOM MARGIN;
06900 NUM ← INTSCAN(LINE,ZILCH);
07000 ZILCH←LOP(LINE);
07100 OUTBUF ← OUTBUF & BOTM & LDXNUM(NUM);
07200 END "C";
07300 BEGIN "D" ! D=NUMBER OF LINES;
07400 NUM ← INTSCAN(LINE,ZILCH);
07500 ZILCH←LOP(LINE);
07600 OUTBUF ← OUTBUF & NUML & LDXNUM(NUM);
07700 END "D";
07800 BEGIN "E" ! E=USE A KSET;
07900 OUTBUF ← OUTBUF & USEA;
08000 AKSET←TRUE;
08100 END "E";
08200 BEGIN "F" ! F=USE B KSET;
08300 OUTBUF ← OUTBUF & USEB;
08400 AKSET←FALSE;
08500 END "F";
08600 BEGIN "G" ! G=JWIDTH;
08700 NUM ← INTSCAN(LINE,ZILCH);
08800 ZILCH←LOP(LINE);
08900 OUTBUF ← OUTBUF & JWID & LDXNUM(NUM);
09000 END "G";
09100 BEGIN "H" ! H=JPAD(JMAX);
09200 NUM ← INTSCAN(LINE,ZILCH);
09300 ZILCH←LOP(LINE);
09400 OUTBUF ← OUTBUF & JPAD & LDXNUM(NUM);
09500 END "H";
09600 BEGIN "I" ! I=XTAB;
09700 USERERR(0,1,"XTABS IN AN XGP COMMAND LINE ARE MEANINGLESS."&CRLF&OUTBUF&LF&LINE);
09800 NUM←INTSCAN(LINE,ZILCH);
09900 ZILCH←LOP(LINE);
10000 END "I";
10100 BEGIN "J" ! J=CHANGE CONTROL CHARACTER;
10200 ZILCH←LOP(LINE);
10300 CC←LINE; LINE←LINE[2 TO INF]; ! BECAUSE OF SAIL BUG;
10400 SETBREAK(MAINBRK,RUBOUT&LF&CC&COMPKSET&CKNJB,CR,"INS");
10500 SETBREAK(TEXTBRK,RUBOUT&CC&COMPKSET&CKNJB,NULL,"IS");
10600 END "J";
10700 BEGIN "K" ! K=CHANGE NON-JUSTIFYING BLANK CHARACTER;
10800 ZILCH←LOP(LINE);
10900 NJB←LOP(LINE);
11000 IF NJB='40 THEN NJB←0;
11100 SETBREAK(MAINBRK,RUBOUT&LF&CC&COMPKSET&CKNJB,CR,"INS");
11200 SETBREAK(TEXTBRK,RUBOUT&CC&COMPKSET&CKNJB,NULL,"IS");
11300 END "K";
11400 BEGIN "L" ! L=VARIABLE SIZE BLANK;
11500 USERERR(0,1,"XVSB IN AN XGP COMMAND LINE IS MEANINGLESS."&CRLF&OUTBUF&LF&LINE);
11600 NUM←INTSCAN(LINE,ZILCH);
11700 ZILCH←LOP(LINE);
11800 END "L";
11900 BEGIN "M" ! M=LEFT MARGIN;
12000 NUM←INTSCAN(LINE,ZILCH);
12100 ZILCH←LOP(LINE);
12200 OUTBUF←OUTBUF & LFTM & LDXNUM(NUM);
12300 END "M";
12400 BEGIN "N" ! N=BJUSTIFY=YES;
12500 OUTBUF←OUTBUF&XBJY;
12600 END "N";
12700 BEGIN "O" ! O=BJUSTIFY=NO;
12800 OUTBUF←OUTBUF&XBJN;
12900 END "O";
13000 BEGIN "P" ! P=QUOTE NEXT CHARACTER;
13100 USERERR(0,1,"XQUOTE IN COMMAND LINE IS MEANINGLESS."&CRLF&OUTBUF&LF&LINE);
13200 ZILCH←LOP(LINE);
13300 END "P";
13400 END; ! OF CASE;
13500
13600 END "DECOD" UNTIL (CMDCHR←LOP(LINE))≠CC;
13700 OUTBUF ← OUTBUF & ECL;
13800 OUT(OUTCHN,OUTBUF);
13900 OUTBUF←NULL;
14000 IF LENGTH(LINE←INPUT(INCHN,MAINBRK))=0 AND BRCHR=LF THEN LINE←INPUT(INCHN,MAINBRK);
14100
14200 END "PROCL";
14300
00100
00200 OPEN(OUTCHN←GETCHAN,"DSK",0,0,2,0,ZILCH,ZILCH);
00300 OPEN(INCHN←GETCHAN,"DSK",0,2,0,INLENGTH←200,BRCHR,EOF);
00400 SETBREAK(LFBRK←GETBRK,LF,CR,"INS");
00500 SETBREAK(LFAPPBRK←GETBRK,LF,NULL,"INA");
00600
00700 OUTFILE←NULL;
00800
00900 WHILE TRUE DO
01000 BEGIN "LOOKUP"
01100 IF NOT RPGSW THEN OUTSTR("Input file: ");
01200 FILE←CVFIL((INFILE←IF RPGSW THEN RPGFILE ELSE INCHWL),EXT,PPN);
01300 LOOKUP(INCHN,INFILE,DUM);
01400 IF DUM THEN
01500 BEGIN "TRYDOC"
01600 IF PPN≠0 THEN PPNSTR←"["&CVOS(PPN LSH -18)&","&CVOS(PPN LAND '777777)&"]" ELSE PPNSTR←NULL;
01700 IF EXT=0 THEN
01800 BEGIN
01900 SDUM←CVXSTR(FILE)&".DOC"&PPNSTR;
02000 LOOKUP(INCHN,SDUM,DUM);
02100 IF NOT DUM THEN DONE;
02200 END;
02300 END "TRYDOC"
02400 ELSE DONE;
02500 OUTSTR("CANNOT LOOKUP """&INFILE&""". ");
02600 OUTFILE←NULL;
02700 END "LOOKUP";
02800
02900
03000 IF LENGTH(OUTFILE)=0 THEN OUTFILE←CVXSTR(FILE)&".XGO";
03100 ENTER(OUTCHN,OUTFILE,ZILCH);
03200
03300 CC←'26; NJB←0;
03400
03500 SETBREAK(MAINBRK←GETBRK,RUBOUT&LF&CC&COMPKSET&CKNJB,CR,"INS");
03600 SETBREAK(TEXTBRK←GETBRK,RUBOUT&CC&COMPKSET&CKNJB,NULL,"IS");
03700
03800 OUTSTR("P U B P A S S T H R E E ---"&CRLF);
03900 AKSET←TRUE;
04000 LINE ← INPUT(INCHN,MAINBRK);
04100 ! ZILCH←LOP(LINE);
04200
04300 WHILE NOT EOF DO
04400 BEGIN "MAIN"
04500 WHILE BRCHR = 0 AND NOT EOF DO LINE ← LINE & INPUT(INCHN,MAINBRK);
04600 IF BRCHR = LF THEN OUTPUTLINE(LINE)
04700 ELSE IF BRCHR=RUBOUT THEN LINE←LINE&DOESCAPE(TRUE)
04800 ELSE PROCESSLINE;
04900 END "MAIN";
05000
05100 RELEASE(INCHN);
05200 RELEASE(OUTCHN);
05300 OUTSTR(OUTFILE&" WRITTEN"&CRLF);
05400 START!CODE
05500 DEFINE CALLI="'47000000000";
05600 CALLI 1,'12;
05700 CALLI 0,'12;
05800 END;
05900 END "DOXAP"